home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch6 / SubEdge.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-04-25  |  6.3 KB  |  194 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Begin VB.Form frmSubEdge 
  4.    Caption         =   "SubEdge []"
  5.    ClientHeight    =   2910
  6.    ClientLeft      =   165
  7.    ClientTop       =   735
  8.    ClientWidth     =   5175
  9.    LinkTopic       =   "Form2"
  10.    ScaleHeight     =   2910
  11.    ScaleWidth      =   5175
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin MSComDlg.CommonDialog dlgOpenFile 
  14.       Left            =   0
  15.       Top             =   840
  16.       _ExtentX        =   847
  17.       _ExtentY        =   847
  18.       _Version        =   393216
  19.    End
  20.    Begin VB.PictureBox picOriginal 
  21.       AutoSize        =   -1  'True
  22.       Height          =   2775
  23.       Left            =   120
  24.       ScaleHeight     =   181
  25.       ScaleMode       =   3  'Pixel
  26.       ScaleWidth      =   157
  27.       TabIndex        =   1
  28.       Top             =   0
  29.       Width           =   2415
  30.    End
  31.    Begin VB.PictureBox picResult 
  32.       Height          =   2775
  33.       Left            =   2640
  34.       ScaleHeight     =   181
  35.       ScaleMode       =   3  'Pixel
  36.       ScaleWidth      =   157
  37.       TabIndex        =   0
  38.       Top             =   0
  39.       Width           =   2415
  40.    End
  41.    Begin VB.Menu mnuFile 
  42.       Caption         =   "&File"
  43.       Begin VB.Menu mnuFileOpen 
  44.          Caption         =   "&Open..."
  45.          Shortcut        =   ^O
  46.       End
  47.       Begin VB.Menu mnuFileSaveAs 
  48.          Caption         =   "Save &As..."
  49.          Shortcut        =   ^A
  50.       End
  51.    End
  52. Attribute VB_Name = "frmSubEdge"
  53. Attribute VB_GlobalNameSpace = False
  54. Attribute VB_Creatable = False
  55. Attribute VB_PredeclaredId = True
  56. Attribute VB_Exposed = False
  57. Option Explicit
  58. ' Arrange the controls.
  59. Private Sub ArrangeControls()
  60.     ' Position the result PictureBox.
  61.     picResult.Move _
  62.         picOriginal.Left + picOriginal.Width + 120, _
  63.         picOriginal.Top, _
  64.         picOriginal.Width, _
  65.         picOriginal.Height
  66.     picResult.Cls
  67.     ' This makes the image resize itself to
  68.     ' fit the picture.
  69.     picResult.Picture = picResult.Image
  70.     ' Make the form big enough.
  71.     Width = picResult.Left + picResult.Width + _
  72.         Width - ScaleWidth + 120
  73.     Height = picResult.Top + picResult.Height + _
  74.         Height - ScaleHeight + 120
  75.     DoEvents
  76. End Sub
  77. ' Transform the image.
  78. Private Sub TransformImage()
  79. Dim pixels() As RGBTriplet
  80. Dim bits_per_pixel As Integer
  81. Dim brightness As Integer
  82. Dim X As Integer
  83. Dim Y As Integer
  84.     ' Get the pixels from picOriginal.
  85.     GetBitmapPixels picOriginal, pixels, bits_per_pixel
  86.     ' Set the pixel color values.
  87.     For Y = 0 To picOriginal.ScaleHeight - 2
  88.         For X = 0 To picOriginal.ScaleWidth - 2
  89.             With pixels(X, Y)
  90.                 .rgbRed = Abs(CInt(.rgbRed) - pixels(X + 1, Y + 1).rgbRed)
  91.                 .rgbGreen = Abs(CInt(.rgbGreen) - pixels(X + 1, Y + 1).rgbGreen)
  92.                 .rgbBlue = Abs(CInt(.rgbBlue) - pixels(X + 1, Y + 1).rgbBlue)
  93.             End With
  94.         Next X
  95.     Next Y
  96.     ' Set picResult's pixels.
  97.     SetBitmapPixels picResult, bits_per_pixel, pixels
  98.     picResult.Picture = picResult.Image
  99. End Sub
  100. ' Start in the current directory.
  101. Private Sub Form_Load()
  102.     picOriginal.AutoSize = True
  103.     picOriginal.ScaleMode = vbPixels
  104.     picOriginal.AutoRedraw = True
  105.     picResult.ScaleMode = vbPixels
  106.     picResult.AutoRedraw = True
  107.     dlgOpenFile.CancelError = True
  108.     dlgOpenFile.InitDir = App.Path
  109.     dlgOpenFile.Filter = _
  110.         "Bitmaps (*.bmp)|*.bmp|" & _
  111.         "GIFs (*.gif)|*.gif|" & _
  112.         "JPEGs (*.jpg)|*.jpg;*.jpeg|" & _
  113.         "Icons (*.ico)|*.ico|" & _
  114.         "Cursors (*.cur)|*.cur|" & _
  115.         "Run-Length Encoded (*.rle)|*.rle|" & _
  116.         "Metafiles (*.wmf)|*.wmf|" & _
  117.         "Enhanced Metafiles (*.emf)|*.emf|" & _
  118.         "Graphic Files|*.bmp;*.gif;*.jpg;*.jpeg;*.ico;*.cur;*.rle;*.wmf;*.emf|" & _
  119.         "All Files (*.*)|*.*"
  120. End Sub
  121. ' Load the indicated file.
  122. Private Sub mnuFileOpen_Click()
  123. Dim file_name As String
  124.     ' Let the user select a file.
  125.     On Error Resume Next
  126.     dlgOpenFile.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
  127.     dlgOpenFile.ShowOpen
  128.     If Err.Number = cdlCancel Then
  129.         Exit Sub
  130.     ElseIf Err.Number <> 0 Then
  131.         Beep
  132.         MsgBox "Error selecting file.", , vbExclamation
  133.         Exit Sub
  134.     End If
  135.     On Error GoTo 0
  136.     Screen.MousePointer = vbHourglass
  137.     DoEvents
  138.     file_name = Trim$(dlgOpenFile.FileName)
  139.     dlgOpenFile.InitDir = Left$(file_name, Len(file_name) _
  140.         - Len(dlgOpenFile.FileTitle) - 1)
  141.     Caption = "SubEdge [" & dlgOpenFile.FileTitle & "]"
  142.     ' Open the original file.
  143.     On Error GoTo LoadError
  144.     picOriginal.Picture = LoadPicture(file_name)
  145.     On Error GoTo 0
  146.     ' Make picResult the same size and position it.
  147.     ArrangeControls
  148.     ' Make picResult show the same image.
  149.     picResult.Picture = picOriginal.Picture
  150.     DoEvents
  151.     ' Perform the enhancement.
  152.     TransformImage
  153.     Screen.MousePointer = vbDefault
  154.     Exit Sub
  155. LoadError:
  156.     Screen.MousePointer = vbDefault
  157.     MsgBox "Error " & Format$(Err.Number) & _
  158.         " opening file '" & file_name & "'" & vbCrLf & _
  159.         Err.Description
  160. End Sub
  161. ' Save the transformed image.
  162. Private Sub mnuFileSaveAs_Click()
  163. Dim file_name As String
  164.     ' Let the user select a file.
  165.     On Error Resume Next
  166.     dlgOpenFile.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly
  167.     dlgOpenFile.ShowSave
  168.     If Err.Number = cdlCancel Then
  169.         Exit Sub
  170.     ElseIf Err.Number <> 0 Then
  171.         Beep
  172.         MsgBox "Error selecting file.", , vbExclamation
  173.         Exit Sub
  174.     End If
  175.     On Error GoTo 0
  176.     Screen.MousePointer = vbHourglass
  177.     DoEvents
  178.     file_name = Trim$(dlgOpenFile.FileName)
  179.     dlgOpenFile.InitDir = Left$(file_name, Len(file_name) _
  180.         - Len(dlgOpenFile.FileTitle) - 1)
  181.     Caption = "SubEdge [" & dlgOpenFile.FileTitle & "]"
  182.     ' Save the transformed image into the file.
  183.     On Error GoTo SaveError
  184.     SavePicture picResult.Picture, file_name
  185.     On Error GoTo 0
  186.     Screen.MousePointer = vbDefault
  187.     Exit Sub
  188. SaveError:
  189.     Screen.MousePointer = vbDefault
  190.     MsgBox "Error " & Format$(Err.Number) & _
  191.         " saving file '" & file_name & "'" & vbCrLf & _
  192.         Err.Description
  193. End Sub
  194.